home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol058 / printmar.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1987-01-13  |  4.6 KB  |  166 lines
  1. 100  TITLE$ = "Print the Marriages File Program"
  2. 105  TITLE$ = TITLE$ + " ON DISPLAY"
  3. 110  VERSION$ = "Version 1.3"
  4. 115  COPY1$ = "Copyright (c) 1983, by:"
  5. 120  COPY2$ = "Melvin O. Duke"
  6. 125  PRICE$ = "$35"
  7. 130  ADDR1$ = "Melvin O. Duke"
  8. 135  ADDR2$ = "P. O. Box 20836"
  9. 140  ADDR3$ = "San Jose, CA  95160"
  10. 145  REM Dimension Statements go here
  11. 170  REM Produce the first screen
  12. 175  KEY OFF : CLS
  13. 180  REM Draw the outer double box
  14. 185  R1 = 1 : C1 = 1 : R2 = 24 : C2 = 79 : GOSUB 400
  15. 190  REM Find the title location
  16. 195  TITLE.POS = 40 - INT(LEN(TITLE$)/2)
  17. 200  REM Draw the title box
  18. 205  R1=3:C1=TITLE.POS-2:R2=6:C2=TITLE.POS+LEN(TITLE$)+1:GOSUB 600
  19. 210  REM Print the title
  20. 215  LOCATE 4,TITLE.POS : PRINT TITLE$
  21. 220  LOCATE 5,40-INT(LEN(VERSION$)/2) :  PRINT VERSION$;
  22. 225  REM Draw the Contribution box
  23. 230  R1 = 8 : C1 = 19 : R2 = 17 : C2 = 62 : GOSUB 400
  24. 235  REM Request the Contribution
  25. 240  LOCATE 9,23 : PRINT "If you are using these programs, and"
  26. 245  LOCATE 10,21 : PRINT "finding them of value, your contribution"
  27. 250  LOCATE 11,23 : PRINT "("+PRICE$+" suggested) will be appreciated."
  28. 255  REM Draw the Mailing Label
  29. 260  R1 = 12 : C1 = 28 : R2 = 16 : C2 = 52 : GOSUB 600
  30. 265  REM Print the Name and Address
  31. 270  LOCATE 13,40-INT(LEN(ADDR1$)/2) :  PRINT ADDR1$;
  32. 275  LOCATE 14,40-INT(LEN(ADDR2$)/2) :  PRINT ADDR2$;
  33. 280  LOCATE 15,40-INT(LEN(ADDR3$)/2) :  PRINT ADDR3$;
  34. 285  REM Draw the Copyright box
  35. 290  R1 = 19 : C1 = 27 : R2 = 22 : C2 = 53 : GOSUB 400
  36. 295  REM Print the Copyright
  37. 300  LOCATE 20,40-INT(LEN(COPY1$)/2) :  PRINT COPY1$;
  38. 305  LOCATE 21,40-INT(LEN(COPY2$)/2) :  PRINT COPY2$;
  39. 310  GOTO 740
  40. 400  REM subroutine to print a double box
  41. 410  FOR I = R1 + 1 TO R2 - 1
  42. 420   LOCATE I, C1 : PRINT CHR$(186);
  43. 430   LOCATE I, C2 : PRINT CHR$(186);
  44. 440  NEXT I
  45. 450  FOR J = C1 + 1 TO C2 - 1
  46. 460   LOCATE R1, J : PRINT CHR$(205);
  47. 470   LOCATE R2, J : PRINT CHR$(205);
  48. 480  NEXT J
  49. 490   LOCATE R1, C1 : PRINT CHR$(201);
  50. 500   LOCATE R1, C2 : PRINT CHR$(187);
  51. 510   LOCATE R2, C1 : PRINT CHR$(200);
  52. 520   LOCATE R2, C2 : PRINT CHR$(188);
  53. 530  RETURN
  54. 600  REM subroutine to print a single box
  55. 610  FOR I = R1 + 1 TO R2 - 1
  56. 620   LOCATE I, C1 : PRINT CHR$(179);
  57. 630   LOCATE I, C2 : PRINT CHR$(179);
  58. 640  NEXT I
  59. 650  FOR J = C1 + 1 TO C2 - 1
  60. 660   LOCATE R1, J : PRINT CHR$(196);
  61. 670   LOCATE R2, J : PRINT CHR$(196);
  62. 680  NEXT J
  63. 690   LOCATE R1, C1 : PRINT CHR$(218);
  64. 700   LOCATE R1, C2 : PRINT CHR$(191);
  65. 710   LOCATE R2, C1 : PRINT CHR$(192);
  66. 720   LOCATE R2, C2 : PRINT CHR$(217);
  67. 730  RETURN
  68. 740  REM ask user to press a key to continue
  69. 750  LOCATE 25,1
  70. 760  PRINT "Press any key to continue";
  71. 770  K$ = INKEY$ : IF K$ = "" THEN 770
  72. 780  CLS
  73. 1000  REM Print the Marriages File Program.
  74. 1010  REM By:  Melvin O. Duke.  Updated 26 June, 1983.
  75. 1020  OPEN "a:persfile" AS #1 LEN = 256
  76. 1030  FIELD 1, 5 AS F1$, 20 AS F2$, 30 AS F3$, 2 AS F4$, 5 AS F5$, 5 AS F6$, 5 AS F7$, 11 AS F8$, 18 AS F9$, 16 AS F10$, 16 AS F11$, 11 AS F12$, 18 AS F13$, 16 AS F14$, 16 AS F15$, 11 AS F16$, 18 AS F17$, 16 AS F18$, 16 AS F19$
  77. 1040  OPEN "a:marrfile" AS #2 LEN = 128
  78. 1050  FIELD 2, 5 AS M1$, 5 AS M2$, 5 AS M3$, 5 AS M4$, 11 AS M5$, 18 AS M6$, 16 AS M7$, 16 AS M8$, 45 AS M9$
  79. 1060  REM Determine User Wants
  80. 1070  CLS : LOCATE 21,1
  81. 1080  INPUT "Enter the Marriage Number to be Printed (0 to quit), or 'all'"; REPLY$
  82. 1090  IF REPLY$ = "0" THEN 1880
  83. 1100  K = 0
  84. 1110  GOTO 1160
  85. 1120  LPRINT TAB(10);"Print-out of Contents of the Marriages File"
  86. 1130  LPRINT TAB(10);DATE$,TIME$
  87. 1140  LPRINT
  88. 1150  RETURN
  89. 1160  IF REPLY$ = "all" THEN 1230
  90. 1170  K = 4
  91. 1180  I = VAL(REPLY$)
  92. 1190  IF I = 0 THEN 1880
  93. 1200  IF I < 1 OR I > 200 THEN 1060
  94. 1210  GOSUB 1120
  95. 1220  GOSUB 1270 : GOTO 1070
  96. 1230  REM Read all records, and print the actual ones
  97. 1240  FOR I = 1 TO 200
  98. 1250  GOSUB 1270
  99. 1260  GOTO 1810
  100. 1270  GET #2, I
  101. 1280  REM Extract information from the file for use
  102. 1290  T1 = CVS(M1$)
  103. 1300  IF T1 < 1 THEN 1800
  104. 1310  K = K + 1
  105. 1320  IF K MOD 5 = 1 THEN GOSUB 1120
  106. 1330  T2 = CVS(M2$)
  107. 1340  T3 = CVS(M3$)
  108. 1350  T4 = CVS(M4$)
  109. 1360  T5$ = M5$
  110. 1370  T6$ = M6$
  111. 1380  T7$ = M7$
  112. 1390  T8$ = M8$
  113. 1400  T9$ = M9$
  114. 1410  REM obtain the name of the husband
  115. 1420  GET #1, T2
  116. 1430  REM obtain the last and given names
  117. 1440  TEMP$ = F2$ 'Husband`s last name
  118. 1450  TMP$ = F2$
  119. 1460  GOSUB 1830
  120. 1470  TT2$ = TMP$
  121. 1480  TEMP$ = F3$ 'Husband's given names
  122. 1490  TMP$ = F3$
  123. 1500  GOSUB 1830
  124. 1510  TT3$ = TMP$
  125. 1520  REM obtain the name of the wife
  126. 1530  GET #1, T3
  127. 1540  REM obtain the last and given names
  128. 1550  TEMP$ = F2$ 'Wife`s last name
  129. 1560  TMP$ = F2$
  130. 1570  GOSUB 1830
  131. 1580  TT4$ = TMP$
  132. 1590  TEMP$ = F3$ 'Wife's given names
  133. 1600  TMP$ = F3$
  134. 1610  GOSUB 1830
  135. 1620  TT5$ = TMP$
  136. 1630  REM Now Print the Information
  137. 1640  LPRINT TAB(10);"Marriage Record-number : ";
  138. 1650  LPRINT USING "###"; T1
  139. 1660  LPRINT TAB(10);"Husband's Record Number: ";
  140. 1670  LPRINT USING "###"; T2;
  141. 1680  LPRINT TAB(42); TT2$+", "+TT3$
  142. 1690  LPRINT TAB(10);"Wife`s Record Number   : ";
  143. 1700  LPRINT USING "###"; T3;
  144. 1710  LPRINT TAB(42); TT4$+", "+TT5$
  145. 1720  LPRINT TAB(10);"Marriage-date          : ";T5$
  146. 1730  LPRINT TAB(10);"Marriage-city          : ";T6$
  147. 1740  LPRINT TAB(10);"Marriage-county        : ";T7$
  148. 1750  LPRINT TAB(10);"Marriage-state         : ";T8$
  149. 1760  LPRINT TAB(10);"Comments: ";T9$
  150. 1770  LPRINT
  151. 1780  LPRINT : LPRINT
  152. 1790  IF K MOD 5 = 0 THEN LPRINT CHR$(12);
  153. 1800  RETURN
  154. 1810  NEXT I
  155. 1820  GOTO 1880
  156. 1830  REM rtrim$ subroutine
  157. 1840  FOR J = 1 TO LEN(TEMP$)-1
  158. 1850   IF RIGHT$(TMP$,1)=" " THEN TMP$ = LEFT$(TMP$,LEN(TMP$)-1) ELSE J = LEN(TEMP$)-1
  159. 1860  NEXT J
  160. 1870  RETURN
  161. 1880  CLOSE #1
  162. 1890  CLS : LOCATE 21,1
  163. 1900  PRINT "End of Program"
  164. 1910  LPRINT CHR$(12);
  165. 1920  END
  166.